home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / UNITS / PBDBOBJ.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  21KB  |  733 lines
  1. {SECTION ..PbDBOBJ }
  2. Unit PbDBOBJ;
  3.  
  4. INTERFACE
  5.  
  6. Uses PbMISC, PbOBJS, PbXBASE;
  7.  
  8. {
  9. Description : xBase DBF file (and my index files) - Object
  10.  
  11. Author      : Howard Richoux
  12. Date        : 12/9/93
  13. Last revised: 1/18/94 added non-object support procs (FLIST oriented)
  14.               1/30/94       logkeyuse flag to turn on write statements
  15.               2/2/94  TURN OFF WRITE ON KEYED_DBF_OBJECT - glitches
  16.               2/9/94  implement FETCHWHERE, fix rec count
  17.               2/18/94 NEW LIBRARIES
  18. Application : IBM PC and compatibles, done in Turbo Pascal 7
  19. Status      : Placed in the Public Domain by HNR Software 1/29/1994
  20. Published in: none
  21. }
  22.  
  23. {SECTION .DBF_object }
  24. const dbfTESTMODE  =  0;
  25.  
  26. {-}
  27. type DbbuftoPasProc = procedure( var rec );
  28. type PastoDbbufProc = procedure( var rec );
  29.  
  30. type DBF_object = OBJECT
  31.              dbf      : XBASE_DBF_object;
  32.              filename : string[60];
  33.              recsize  : integer;
  34.              numrecs  : longint;
  35.              opened   : boolean;
  36.              CurrRec  : longint;
  37.              CurrKey  : longint;   { only really applies to KEYED_DBF }
  38.              err      : integer;
  39.  
  40.              procedure init(fn : string; recsz : integer; dbfmode : integer);
  41.              Function  NoError : boolean;
  42.              Function  exportfielddefn(fldnum : integer) : string;
  43.              Procedure fileerror (e : integer);
  44.              Function  seekn     (n : longint) : boolean;
  45.              Procedure TOP;                   {sets CurrRec to 0, cant fail }
  46.              Function  fetchn    (n : longint) : boolean;
  47.              Function  storen    (n : longint) : boolean;
  48.              Function  exportrecn(n : longint) : string;
  49.              Function  append                  : boolean;
  50.              Function  fetchnext               : boolean;
  51.              Function  fetchwhere(fldspec : string; opr : char; fldval : string):boolean;
  52.              Function  count                   : longint;
  53.              procedure done;
  54.              procedure dump;
  55.              end;
  56. {+}
  57. {SECTION .KEYED_DBF_object }
  58. {-}
  59. type KeyPiece_rec = record
  60.              keyfld      : byte;      { which DBF field }
  61.              keylen      : byte;      { how much to use }
  62.              keystrxx    : string[16] { undecoded string }
  63.              end;
  64.  
  65. const maxkeyfields = 10;
  66.  
  67. type KEYED_DBF_object = OBJECT(DBF_object)
  68.              dbndx       : HOLD_object;   { the key array }
  69.              keytag      : string[3];     { also the file extension }
  70.              keyspec     : string;        { 'xxx[3]+yyy+zzz[5]' }
  71.              ndxdef      : array[1..maxkeyfields] of KeyPiece_rec;
  72.              ndxfilename : string[60];    { DBF filename with tag ext }
  73.              ndxloaded   : boolean;
  74.              logkeyuse   : boolean;       { turn on write statements }
  75.  
  76.              Procedure init      (fn : string; recsz : integer;
  77.                                   dbfmode : integer; tag : string;
  78.                                   keyspecstr : string; keymax : integer);
  79.              Procedure reloadndx (fn,tag,keyspecstr : string;
  80.                                   keymax : integer);
  81.              Function  loadndx   : boolean;
  82.              Procedure dbDecodeNdxPiece(ndxstr :string;var fld,ln :byte);
  83.              Procedure dbDecodekeyspec;
  84.              Function  dbConstructKeyStr : string;
  85.              Function  createndx : boolean;
  86.              Procedure TOP;                   {sets CurrKey to 0, cant fail }
  87.              Function  seekn     (n : longint) : boolean;
  88.              Function  fetchn    (n : longint) : boolean;
  89.              Function  storen    (n : longint) : boolean;
  90.              Function  exportrecn(n : longint) : string;
  91.              Function  append                  : boolean;
  92.              Function  fetchnext               : boolean;
  93.              procedure done;
  94.              end;
  95. {+}
  96.  
  97. {SECTION .Procedures }
  98. Procedure FStringToFList(fstring : string; var x : DBF_object; var FList : HOLD_object);
  99.                 {[DBF] converts a spec string  [FLD1(3)+FLD2]  into a FList }
  100.  
  101. Function  FListDataStr(var FList : HOLD_object; var x : DBF_object) : string;
  102.             {[DBF] makes a key string out of record data via FList }
  103.  
  104.  
  105. {SECTION .zImplementation }
  106. IMPLEMENTATION
  107.  
  108. {SECTION  DBF_object  }
  109. procedure DBF_object.init(fn : string; recsz : integer; dbfmode : integer);
  110.      begin
  111.      filename := fn;
  112.      recsize  := 0;
  113.      opened   := false;
  114.      CurrRec  := 0;
  115.      CurrKey  := 0;
  116.      numrecs  := 0;
  117.      err      := 0;
  118.  
  119.      case dbfmode of
  120.          fREADONLY   : dbf.init(fn,true);
  121.          fREADWRITE  : dbf.init(fn,false);
  122.          fCREATE     : begin
  123.                        writeln('dbfCREATE function not implemented');
  124.                        err := -1;
  125.                        end;
  126.          else          begin
  127.                        writeln('Unknown INIT function');
  128.                        err := -2;
  129.                        end;
  130.          end;
  131.      err := dbf.err;
  132.      if err = 0 then
  133.           begin
  134.           opened := true;
  135.           numrecs := dbf.dbhead.no_rec;
  136.           recsize := dbf.dbhead.rec_bytes;
  137.           CurrRec := dbf.db_rec_no;
  138.           if (recsz <> 0) and (recsize <> recsz) then
  139.                begin
  140.                err := -3;
  141.                writeln('INIT FAILURE (record size)  code=',recsz,
  142.                        '   file=',recsize);
  143.                dbf.done;
  144.                end;
  145.           end;
  146.      end;
  147.  
  148.  
  149. Function  DBF_object.NoError : boolean;
  150.      begin
  151.      NoError := (err = 0);
  152.      end;
  153.  
  154.  
  155. Procedure DBF_object.fileerror (e : integer);
  156.      begin
  157.      err := e;
  158.      if not NoError then writeln('DBF_object: ',DOSErrStr(dbf.err),' ',dbf.err);
  159.      end;
  160.  
  161.  
  162. Function  DBF_object.exportfielddefn(fldnum : integer) : string;
  163. var s : string;
  164.     i : integer;
  165.     fldnam : string;
  166.     rtype  : char;
  167.     width, decp : byte;
  168.      begin
  169.      s := '';
  170.      exportfielddefn := s;
  171.      if not opened then
  172.           begin
  173.           writeln('File not open [exportflddef]');
  174.           exit;
  175.           end;
  176.      i := fldnum;
  177.      if (i > 0) and (i <= dbf.no_col) then
  178.           begin
  179.           dbf.dbFieldInfo(i,fldnam,rtype,width,decp);
  180.           s := fldnam + '('+rtype+integerstr(width,3);
  181.           if rtype = 'N' then s := s + '.' + integerstr(decp,2);
  182.           s := s + ')';
  183.           RemoveBlanks(s);
  184.           end;
  185.      exportfielddefn := s;
  186.      end;
  187.  
  188.  
  189.  
  190. Procedure DBF_object.done;
  191.      begin
  192.      err := 0;
  193.      if not dbf.opened then exit;
  194.      dbf.done;
  195.      err := dbf.err;
  196.      end;
  197.  
  198.  
  199. Procedure DBF_object.dump;
  200.      begin
  201.      if not opened then
  202.           begin
  203.           writeln('File not open [dump]');
  204.           exit;
  205.           end;
  206.      dbf.dbshowstruc;
  207.      dbf.dblistrecs;
  208.      end;
  209.  
  210.  
  211. Function  DBF_object.count : longint;
  212.      begin
  213.      numrecs := dbf.dbhead.no_rec;
  214.      count := numrecs;
  215.      end;
  216.  
  217.  
  218. Function  DBF_object.seekn    (n : longint) : boolean;
  219.      begin
  220.      err := 0;
  221.      if not opened then
  222.           begin
  223.           seekn := false;
  224.           writeln('File not open [seek]');
  225.           exit;
  226.           end;
  227.      dbf.dbgoto(n);
  228.      err     := dbf.err;
  229.      seekn   := NoError;
  230.      CurrRec := dbf.db_rec_no;
  231.      end;
  232.  
  233.  
  234. Procedure DBF_object.TOP;
  235.      begin
  236.      CurrRec := 0;
  237.      dbf.dbgoto(0);
  238.      err := 0;
  239.      end;
  240.  
  241.  
  242. Function  DBF_object.fetchn  (n : longint) : boolean;
  243.      begin
  244.      err := 0;
  245.      fetchn := false;
  246.      if not opened then
  247.           begin
  248.           writeln('File not open [fetchn]');
  249.           exit;
  250.           end;
  251.      dbf.dbgoto(n);
  252.      err := dbf.err;
  253.      if dbf.err = 0 then
  254.           begin
  255.           CurrRec := dbf.db_rec_no;
  256.           fetchn := true;
  257.           end
  258.      else dbf.dbcleardbbuf;
  259.      fetchN := NoError;
  260.      end;
  261.  
  262.  
  263. Function  DBF_object.fetchnext : boolean;
  264. var currec : integer;
  265.      begin
  266.      err := 0;
  267.      currec := CurrRec;
  268.      fetchnext := false;
  269.      if not opened then
  270.           begin
  271.           writeln('File not open [fetchnext]');
  272.           exit;
  273.           end;
  274.      inc(currec);
  275.      fetchnext := fetchN(currec);
  276.      end;
  277.  
  278.  
  279. Function  DBF_object.fetchwhere(fldspec : string; opr : char; fldval : string):boolean;
  280.     { Current implementation - FIELDSPEC can only be a field name
  281.              only implementing "=" and doing trim and UpCase }
  282. var found,ok : boolean;
  283.     i        : longint;
  284.     s,fval   : string;
  285.      begin
  286.      found := false; ok := true;
  287.      fval := fldval;
  288.      trim(fval);
  289.      fval := UpCaseStr(fval);
  290.      i := CurrRec;
  291.      while (i < count) and not found do
  292.           begin
  293.           inc(i);
  294.           ok := fetchn(i);
  295.           if ok then
  296.                begin
  297.                s := dbf.dbstr(dbf.dbfldno(fldspec));
  298.                trim(s);
  299.                s := UpCaseStr(s);
  300.                if compare(s,fval) then
  301.                     begin
  302.                     found := true;
  303.                     end;
  304.                end
  305.           end;
  306.      fetchwhere := found;
  307.      end;
  308.  
  309.  
  310. Function  DBF_object.storen  (n : longint) : boolean;
  311.      begin
  312.      err := 0;
  313.      storen := false;
  314.      if not opened then
  315.          begin
  316.          writeln('File not open [storen]');
  317.          exit;
  318.          end;
  319.      dbf.dbposition(n);
  320.      err := dbf.err;
  321.      if NoError then
  322.          begin
  323.          dbf.dbrewrite(n);
  324.          if NoError then
  325.               begin
  326.               CurrRec := dbf.db_rec_no;
  327.               storen := true;
  328.               end;
  329.          end;
  330.      end;
  331.  
  332.  
  333. Function  DBF_object.append : boolean;
  334.      begin
  335.      err := 0;
  336.      append := false;
  337.      if not opened then
  338.          begin
  339.          writeln('File not open [append]');
  340.          exit;
  341.          end;
  342.      dbf.dbappend;
  343.      err := dbf.err;
  344.      if NoError then
  345.               begin
  346.               CurrRec := dbf.db_rec_no;
  347.               numrecs := CurrRec;
  348.               append := true;
  349.               end;
  350.      end;
  351.  
  352.  
  353. Function DBF_object.exportrecn  (n : longint) : string;
  354. var i    : integer;
  355.     s,s1 : string;
  356.      begin
  357.      err := 0;
  358.      s := '';
  359.      if not opened then
  360.           begin
  361.           writeln('File not open [exportrec]');
  362.           exportrecn := s;
  363.           exit;
  364.           end;
  365.      dbf.dbgoto(n);
  366.      if dbf.err = 0 then
  367.           begin
  368.           for i := 1 to dbf.no_col do
  369.                begin
  370.                s1 := dbf.dbstr(i);
  371.                trim(s1);
  372.                s := s + s1;
  373.                if i < dbf.no_col then s := s + ',';
  374.                end;
  375.           end;
  376.      exportrecn := s;
  377.      end;
  378.  
  379.  
  380. {SECTION  KEYED_DBF_object  }
  381.  
  382. {Notes:  11/30/93 - compound key support passes a key string instead
  383.    of a field name.  The key string is a series of field names with optional
  384.    length specifiers (in square brackets) joined by plusses.  Blanks are all
  385.    removed prior to processing.  Literals can be placed in the string as long
  386.    as they aren't genuine field names (literals are not enclosed in quotes).
  387.    [*] means trim blanks from field.
  388.  
  389.    Examples: (quotes are not part of the definition)
  390.       'field2'
  391.       'field1[3]+field3[*]'
  392.       'field3[*]+(+field1[2]+)'
  393.  
  394. }
  395.  
  396. Procedure KEYED_DBF_object.init(fn : string; recsz : integer;
  397.                                 dbfmode : integer; tag : string;
  398.                                 keyspecstr : string; keymax : integer);
  399.      begin
  400.      if (dbfmode <> fREADONLY) and
  401.        ((tag <> '') or (keyspecstr <> '')) then
  402.           begin
  403.           err := -10;
  404.           writeln('KEYED_DBF_object INIT [',fn,
  405.                   '] - USE fREADONLY mode with keys.');
  406.           exit;
  407.           end;
  408.      DBF_object.init(fn,recsz,dbfmode);
  409.      if dbf.err = 0 then
  410.           begin
  411.           logkeyuse := false;
  412.           CurrKey := 0;
  413.           dbndx.init(keymax);
  414.           reloadndx(fn,tag,keyspecstr,keymax);
  415.           end;
  416.      end;
  417.  
  418.  
  419. Procedure KEYED_DBF_object.reloadndx (fn,tag,keyspecstr : string;
  420.                                       keymax : integer);
  421.      begin
  422.      err := 0;
  423.      dbndx.done;
  424.      dbndx.init(keymax);
  425.      ndxloaded   := false;
  426.      ndxfilename := fn;
  427.      ForceExt(ndxfilename,tag);
  428.      keytag      := tag;
  429.      keyspec     := keyspecstr;
  430.      if (keytag = '') and (keyspec = '') then
  431.           begin
  432.           if logkeyuse then
  433.                writeln('No KEY specified.  Access will be by record number.');
  434.           exit;
  435.           end;
  436.      if not loadndx then
  437.           begin
  438.           if logkeyuse then
  439.                begin
  440.                writeln('reloadndx Unable to load or create index file for [',
  441.                    filename,']  [',ndxfilename,']');
  442.                writeln('          using tag: [',keytag,
  443.                   ']   DBF field(s): [',keyspec,']');
  444.                writeln('Records will be accessed by record number.');
  445.                end;
  446.           end;
  447.      end;
  448.  
  449.  
  450. Function KEYED_DBF_object.loadndx : boolean;
  451. var s : string;
  452.     loaded : boolean;
  453.      begin
  454.      err := 0;
  455.      ndxloaded := false;
  456.      loadndx := true;
  457.      if keyspec = '' then exit;
  458.     { writeln('loadndx [',filename,']  [',ndxfilename,']');}
  459.      if (keytag <> '') and
  460.         (Filedate(filename,'') < Filedate(ndxfilename,'')) then
  461.            begin
  462.            {writeln('loading index [',ndxfilename,']');}
  463.            dbndx.load(ndxfilename);
  464.            if dbndx.count < 1 then loadndx := false
  465.            else ndxloaded := true;
  466.            end;
  467.       if not ndxloaded and (keyspec <> '') then
  468.            begin
  469.            {writeln('creating index [',ndxfilename,']   please wait a few seconds.');}
  470.            if not createndx then loadndx := false;
  471.            end;
  472.       end;
  473.  
  474.  
  475. Procedure KEYED_DBF_object.dbDecodeNdxPiece(ndxstr :string;var fld,ln :byte);
  476. var s,s1   : string;
  477.     tch    : char;
  478.      begin
  479.      s := ndxstr;
  480.      s1 := GetLeftStr(s,'[');
  481.      if s[length(s)] = ']' then delete(s,length(s),1);
  482.      fld := dbf.dbfldno(s1);
  483.      if      s = '*' then ln := 0
  484.      else if ln = 0  then ln := dbf.dbfldwidth(fld)
  485.      else                 ln := byte(strint(s));
  486.      if (dbfTESTMODE > 0) then writeln('NdxPiece: ',ndxstr,'  ',fld,'  ',ln);
  487.      end;
  488.  
  489.  
  490. Procedure KEYED_DBF_object.dbDecodekeyspec;
  491. var s,s1   : string;
  492.     tch    : char;
  493.     fld,ln : byte;
  494.     i      : integer;
  495.      begin
  496.      s := UpCaseStr(keyspec);
  497.  
  498.      if (dbfTESTMODE > 0) then writeln('Decodekeyspec <',s,'>');
  499.  
  500.      for i := 1 to maxkeyfields do
  501.           begin ndxdef[i].keystrxx := ''; ndxdef[i].keyfld := 0;
  502.                 ndxdef[i].keylen := 0; end;
  503.  
  504.      i := 1;
  505.      while (length(s) > 0) and (i <= maxkeyfields) do
  506.           begin
  507.           fld := 0; ln := 0;
  508.           s1 := GetLeftStr(s,'+');
  509.           if (dbfTESTMODE > 0) then
  510.               writeln('Decodekeyspec1<',s1,'>',i,'  ',fld,'  ',ln);
  511.           if length(s1) > 0 then dbDecodeNdxPiece(s1,fld,ln);
  512.           ndxdef[i].keystrxx := s1;
  513.           ndxdef[i].keyfld := fld;
  514.           ndxdef[i].keylen := ln;
  515.           if (dbfTESTMODE > 0) then
  516.               writeln('Decodekeyspec2<',s1,'>',i,'  ',fld,'  ',ln);
  517.           inc(i);
  518.           end;
  519.      end;
  520.  
  521.  
  522. Function KEYED_DBF_object.dbConstructKeyStr : string;
  523. var i,j,k : integer;
  524.     s,s1 : string;
  525.      begin
  526.      s := '';
  527.      for i := 1 to maxkeyfields do
  528.           begin
  529.           s1 := '';
  530.           j := ndxdef[i].keyfld;
  531.           k := ndxdef[i].keylen;
  532.           if j > 0 then
  533.                begin
  534.                if k > 0 then s1 := leftstr(dbf.dbstr(j),k)
  535.                else begin
  536.                     s1 := dbf.dbstr(j);
  537.                     trim(s1);
  538.                     end;
  539.                end
  540.           else if ndxdef[i].keystrxx <> '' then s1 := ndxdef[i].keystrxx;
  541.           if (dbfTESTMODE > 0) and (s1 <> '') then
  542.                 writeln('dbConstructKeyStr ',i,'  ',j,'  ',k,' <',s1,'>');
  543.           s := s + s1;
  544.           end;
  545.      s1 := s;
  546.      trim(s1);
  547.      if s1 = '' then s := 'zznone';
  548.      dbConstructKeyStr := s;
  549.      end;
  550.  
  551.  
  552.  
  553. Function KEYED_DBF_object.createndx : boolean;
  554. var i,error,fldnum,n : integer;
  555.     s,s1 : string;
  556.      begin
  557.      err := 0;
  558.      createndx := true;
  559.      if keyspec = '' then exit;
  560.      dbndx.comment := keyspec;
  561.      dbDecodekeyspec;
  562.      if (dbfTESTMODE > 0) then
  563.           begin
  564.           writeln('createndx [',filename,']  [',ndxfilename,']');
  565.           writeln('createndx DBF numrecs=',numrecs);
  566.           writeln('createndx DBF field [',keyspec,']  field#=',fldnum);
  567.           end;
  568.      n := numrecs;
  569.      if (dbfTESTMODE > 0) then n := 5;
  570.      for i := 1 to n do
  571.           begin
  572.           dbf.dbgoto(i);
  573.           error := dbf.err;
  574.           if error = 0 then
  575.                begin
  576.                s := dbConstructKeyStr;
  577.                if (dbfTESTMODE > 0) then
  578.                     writeln('createndx index entry[',s,',',i,']');
  579.                dbndx.append(s,i);
  580.                end;
  581.           end;
  582.       dbndx.sort;
  583.       if keytag <> '' then dbndx.save(ndxfilename);
  584.       ndxloaded := true;
  585.       end;
  586.  
  587.  
  588. Function  KEYED_DBF_object.seekn   (n : longint) : boolean;
  589. var ndx : longint;
  590.      begin
  591.      if n > 0 then ndx := n
  592.      else ndx := 1;
  593.      CurrKey := n;
  594.      if ndxloaded then ndx := dbndx.fetchNumN(n);
  595.      seekn := DBF_object.seekn(ndx);
  596.      end;
  597.  
  598.  
  599. Procedure KEYED_DBF_object.TOP;
  600.      begin
  601.      CurrRec := 0;
  602.      CurrKey := 0;
  603.      err := 0;
  604.      end;
  605.  
  606.  
  607.  
  608. Function  KEYED_DBF_object.fetchn  (n : longint) : boolean;
  609. var ndx : longint;
  610.     ok  : boolean;
  611.      begin
  612.      ndx := n;
  613.      if n > numrecs then
  614.           begin
  615.           dbf.dbcleardbbuf;
  616.           fetchn := false;
  617.           exit;
  618.           end;
  619.      CurrKey := n;
  620.      if ndxloaded then ndx := dbndx.fetchNumN(n);
  621.      fetchn := DBF_object.fetchn(ndx);
  622.      end;
  623.  
  624.  
  625. Function  KEYED_DBF_object.append : boolean;
  626. var crec : longint;
  627.      begin
  628.      err := 0;
  629.      ndxloaded := false;
  630.      append := DBF_object.append;
  631.      end;
  632.  
  633.  
  634.  
  635. Function  KEYED_DBF_object.fetchnext : boolean;
  636. var crec : longint;
  637.      begin
  638.      err := 0;
  639.      crec := CurrKey;
  640.      fetchnext := false;
  641.      if not opened then
  642.           begin
  643.           writeln('File not open [fetchnext]');
  644.           exit;
  645.           end;
  646.      inc(crec);
  647.      fetchnext := fetchN(crec);
  648.      end;
  649.  
  650.  
  651.  
  652. Function  KEYED_DBF_object.storen  (n : longint) : boolean;
  653. var ndx : longint;
  654.      begin
  655.      ndx := n;
  656.      CurrKey := n;
  657.      if ndxloaded then ndx := dbndx.fetchNumN(n);
  658.      storen := DBF_object.storen(ndx);
  659.      end;
  660.  
  661.  
  662. Function  KEYED_DBF_object.exportrecn  (n : longint) : string;
  663. var ndx : longint;
  664.      begin
  665.      ndx := n;
  666.      if ndxloaded then ndx := dbndx.fetchNumN(n);
  667.      exportrecn := DBF_object.exportrecn(ndx);
  668.      end;
  669.  
  670.  
  671. Procedure KEYED_DBF_object.done;
  672.      begin
  673.      dbndx.done;
  674.      DBF_object.done;
  675.      end;
  676.  
  677.  
  678. {SECTION  FStringToFList }
  679. Procedure FStringToFList(fstring : string; var x : DBF_object; var FList : HOLD_object);
  680.                 {[DBF] converts a spec string  [FLD1(3)+FLD2]  into a FList }
  681. var s,s1,s2  : string;
  682.     i,l  : integer;
  683.     ch : char;
  684.     begin
  685.     s := UpCaseStr(fstring);
  686.     if s = '[*]' then    {all fields in order - limit 127}
  687.          begin
  688.          for i := 1 to x.dbf.no_col do
  689.               begin
  690.               s1 := '#' + integerstr(i,3);
  691.               removeblanks(s1);
  692.               FList.append(s1,0);
  693.               end;
  694.          end
  695.     else begin
  696.          s := RemoveBrackets(s);
  697.          while length(s) > 0 do
  698.               begin
  699.               s1 := GetLeftStr(s,'+');           {this field}
  700.               s2 := GetDelimitedStr(s1,'(',')'); {length string}
  701.               l  := GetInteger(s2);              {length}
  702.               if l = 0 then
  703.                    l := x.dbf.dbfldwidth(x.dbf.dbfldno(s1));
  704.               FList.append(s1,l);
  705.               end;
  706.          end;
  707.     end;
  708.  
  709.  
  710. {SECTION  FListDataStr }
  711. Function  FListDataStr(var FList : HOLD_object; var x : DBF_object) : string;
  712.             {[DBF] makes a key string out of record data via FList }
  713. var s,nam : string;
  714.     i     : integer;
  715.     len   : longint;
  716.     begin
  717.     s := '';
  718.     if FList.count > 0 then
  719.          begin
  720.          for i := 1 to FList.count do
  721.               begin
  722.               FList.FetchN(i,nam,len);
  723.               s := s + leftstr(x.dbf.dbstr(x.dbf.dbfldno(nam)),len);
  724.               end;
  725.          end;
  726.     FListDataStr := UpCaseStr(trimstr(s));
  727.     end;
  728.  
  729.  
  730. {SECTION zzInitialization }
  731.      begin  {initialization}
  732.      end.
  733.